;; file    : dscurv.scm
;; created : December 1996
;; author  : George Celniker
;; comment : This file contains simple test sequences that were
;;           found helpful in debugging the development of deformable
;;           curves.

;; contains :
;;
;; flight-path( opts )           ;; fit a curve to some data
;;                               ;; opt = cpt_count(def=30)
;;                               ;;       u_min    (def=0)
;;                               ;;       u_max    (def=100)
;;                               ;;       end_time (def=720)
;;                               ;;       samp_cnt (def=121)
;;                               ;;       inc_cnt  (def=3)
;; pull-path( opts )             ;; flight path with default shape
;;                               ;; ready for constraint pt pulling
;;
;; pinned-edge . n         = An n control-pt edge (default n=9)
;;                           with center and corner pt-cstrns.
;;                           Try tracking the pt-cstrns.
;; hinged-edge . n         = An n control-pt edge (default n=9) using
;;                           a tangent constraint at its center
;;                           Try tracking pt and tang cstrns
;; pinned-hinged-edge . n  = An n control-pt edge (default n=9) using
;;                           a tangent and position constraint at its center
;;                           Try tracking pt and tang cstrns
;; pinned2-edge . n        = An n control-pt edge (default n=9)
;;                           with 2 interior plus corner pt-cstrns.
;;                           Try tracking the pt-cstrns.
;; hinged2-edge . n        = An n control-pt edge (default n=9) using
;;                           2 tangent constraints in its interior
;;                           Try tracking pt and tang cstrns
;; pinned-hinged2-edge . n = An n control-pt edge (default n=9) using
;;                           2 tangent/position constraints in its interior
;;                           Try tracking pt and tang cstrns
;; folding-edge . n        = An n control-pt edge (default n=9) using default
;;                           shape to show folding caused by a tracked
;;                           pt-cstrn.
;;
;; sequences to test commit-to-owner
;; ecm0 = no tag objects
;; ecm1 = added pt
;; ecm2 = added distributed pressures
;; ecm3 = added spring load
;; ecm4 = added curve load                     
;; ecm5 = added multiples of above
;; ecm6 = added deletes and multiple commits
;;
;; sequences to test save and restore  (save is defined in dsprob.scm)
;; (save ecm0) (save ecm1) (save ecm2) (save ecm3)
;; (save ecm4) (save ecm5) (save ecm6)
;;
;; (base-edge)                    ;; exercise elevate degree and split
;; (ds-edge-roll)                 ;; exercise rollback
;; (spring-edge-group)            ;; exercise springs
;;
;; (ds-edge-everything)           ;; an edge regression test
;;
(provide 'DScurv)
(require 'DSdemo "dsdemo.scm")         
         
         ;; curve fitting                      ;; fit a curve to some data
(define (flight-path . opt)           ;; opt = cpt_count(def=30)
  ;;       u_min    (def=0)
  ;;       u_max    (def=1000)
  (let                                 ;;       end_time (def=720)
    ((n     (if (not (null? opt))       ;;       samp_cnt (def=121)
                (car opt) 30))          ;;       inc_cnt  (def=3)
     (u_min (if (not (or (null? opt) (null? (cdr opt))))
                (cadr opt)  0.0))
     (u_max (if (not (or (null? opt) (null? (cdr opt)) (null? (cddr opt))))
                (caddr opt) 1000.0))
     (time (if (not (or (null? opt)
                        (null? (cdr opt))
                        (null? (cddr opt))
                        (null? (cdddr opt))))
               (cadddr opt) 720 ))
     (s_cnt (if (not (or (null? opt)
                         (null? (cdr opt))
                         (null? (cddr opt))
                         (null? (cdddr opt))
                         (null? (cddddr opt))))
                (car (cddddr opt)) 121 ))
     (i_cnt (if (not (or (null? opt)
                         (null? (cdr opt))
                         (null? (cddr opt))
                         (null? (cdddr opt))
                         (null? (cddddr opt))
                         (null? (cdr (cddddr opt)))))
                (cadr (cddddr opt)) 3 )))
    (let
      ((samp-pts (ds:gen-path 0 time s_cnt i_cnt)))
      
      (dedge n 0.0 u_min u_max)
      (set! ds-spr (ds:add-spring-set
                     ds-model 1       ; the tgt-model
                     (cadr samp-pts)  ; dpts_list
                     (caddr samp-pts) ; pos_list
                     100))            ; gain
      (ds:set-default-shape ds-model 1 0)
      (ds:set-draw-state ds-model 1 
                         (+ ds-draw-cstrns
                            ds-draw-seams
                            ds-draw-curve-comb
                            ds-draw-loads))
      (ds:set-comb-graphics ds-model 1 25 -100)
      (toggle ds-pt1)
      (toggle ds-pt2)
      (alpha 0)
      (solve)
      (display "\ncontrol pt count   = ") (display n)
      (display "\ndomain range       = [")
      (display u_min) (display ", ") (display u_max) (display "]")
      (display "\nsim time span      = ") (display time)
      (display "\nsamp & inc pt cnts = [")
      (display s_cnt) (display ", ") (display i_cnt) (display "]")
      (display "\ndt time step size  = ")
      (display (/ time (* (- s_cnt 1) i_cnt)))
      (display "\nmax path error[km] = ")
      (display (ds:get-spring-length ds-model ds-spr))
      (display "\nadded spr-set tag  = ") (display ds-spr) (display "\n")
      )))
         
(define (pull-path . opt)
  (if (not (null? opt))
      (flight-path opt)
      (flight-path))
  (toggle ds-pt1)
  (toggle ds-pt2)
  (delete ds-spr)
  (ds:set-draw-state ds-model 1 (+ ds-draw-cstrns
                                   ds-draw-curve-comb))
  (ds:set-default-shape ds-model 1 1) 
  (delta 0) (k) (disp-gain 100 -2)
  (solve)
  )
         
(define (pinned-edge . opt)       ; edge pinned at the corners
  (let ((n (if (not (null? opt)) (car opt) 9)))
    (dedge n 0.0 0 25) 
    (ds:set-default-shape ds-model 1 0)
    (set! ds-pt3 (pc .5 .5)) (k)
    (k) (solve)
    ))
         
(define (hinged-edge . opt)
  (let ((n (if (not (null? opt)) (car opt) 9)))
    (dedge n 0.0 0 25) 
    (ds:set-default-shape ds-model 1 0)
    (set! ds-pt3 (ds:add-pt-cstrn ds-model 1 "tangent" (par-pos .5 .5)))
    (k) (solve)
    ))
         
(define (pinned-hinged-edge . opt)
  (let ((n (if (not (null? opt)) (car opt) 9)))
    (dedge n 0.0 0 25) 
    (ds:set-default-shape ds-model 1 0)
    (set! ds-pt3 (ds:add-pt-cstrn ds-model 1 "pos_tan" (par-pos .5 .5)))
    (k) (solve)
    ))
         
         
(define (pinned2-edge . opt)       ; edge pinned at the corners
  (let ((n (if (not (null? opt)) (car opt) 9)))
    (dedge n 0.0 0 25) 
    (ds:set-default-shape ds-model 1 0)
    (set! ds-pt3 (pc .333 .333))
    (set! ds-pt4 (pc .666 .666))
    (k) (solve)
    ))
         
(define (hinged2-edge . opt)
  (let ((n (if (not (null? opt)) (car opt) 9)))
    (dedge n 0.0 0 25) 
    (ds:set-default-shape ds-model 1 0)
    (set! ds-pt3 (ds:add-pt-cstrn ds-model 1 "tangent" (par-pos .333 .333)))
    (set! ds-pt4 (ds:add-pt-cstrn ds-model 1 "tangent" (par-pos .666 .666)))
    (k) (solve)
    ))
         
(define (pinned-hinged2-edge . opt)
  (let ((n (if (not (null? opt)) (car opt) 12)))
    (dedge n 0.0 0 25) 
    (ds:set-default-shape ds-model 1 0)
    (set! ds-pt3 (ds:add-pt-cstrn ds-model 1 "pos_tan" (par-pos .333 .333)))
    (set! ds-pt4 (ds:add-pt-cstrn ds-model 1 "pos_tan" (par-pos .666 .666)))
    (k) (solve)
    ))
         
(define (folding-edge . opt)
  (let ((n (if (not (null? opt)) (car opt) 9))

        (u_max (if (not (or (null? opt) (null? (cdr opt))))
                (cadr opt) 25)))

    (dedge n 0.0 0 u_max) 
    (ds:set-default-shape ds-model 1 0)
    (set! ds-pt3 (pc .5 .5)) (k)
    (ds:set-comb-graphics ds-model 1 25 -100)
    (sxyz ds-pt3 18 25 0)
    (solve)
    (ds:set-default-shape ds-model 1 1) (delta 100000)
    (solve)
    (sxyz ds-pt3 18 0 0)
    (solve)
    ))
         
         ;; sequences to test commit-to-owner
         ;; sequences cm0 to cm5 are accumulative that is cm5 is a superset
         ;; of cm0.  Once cm5 is running no need to run cm0 to cm4.
         
         ;; ecm0 = no tag objects
         ;; ecm1 = added pt
         ;; ecm2 = added distributed pressures
         ;; ecm3 = added spring load
         ;; ecm4 = added curve load
         ;; ecm5 = added multiples of above
         ;; ecm6 = added deletes and multiple commits
         
(define (ecm0) (display "cm0\n")
  (clear)
  (dedge 9)
  (let ((this-edge ds-model))
    (b) (solve 2 3) (commit) (end)
    (set! ds-model this-edge) (k) (solve))
  )
(define (ecm1)  (display "cm1\n")
  (clear)
  (dedge 9)
  (let ((this-edge ds-model))
    (b) (pc 0.5 0.5)
    (solve 2 3) (commit) (end) (set! ds-model this-edge) (k) (solve))
  )
(define (ecm2)  (display "cm2\n")
  (clear)
  (dedge 9)
  (let ((this-edge ds-model))
    (b) (pc 0.5 0.5) (tc .666 .666)
    (pp 0.4 0.4) (dp) (dp 0  0 0  .3 1)
    (solve 2 3) (commit) (end) (set! ds-model this-edge) (k) (solve))
  )
(define (ecm3)  (display "cm3\n")
  (clear)
  (dedge 20)
  (let ((this-edge ds-model))
    (b) (pc 0.5 0.5) (tc .666 .666)
    (pp 0.4 0.4) (dp) (dp 0   0 0   .3 1) (spr .7 .7)
    (solve 2 3) (commit) (end) (set! ds-model this-edge) (k) (solve))
  )
(define (ecm4)  (display "cm4\n")
  (clear)
  (dedge 20)
  (let ((this-edge ds-model))
    (b) (pc 0.5 0.5) (tc .666 .666)
    (pp 0.4 0.4) (dp) (dp 0   0 0  .3 1)
    (spr .7 .7)
    (solve 2 3) (commit) (end) (set! ds-model this-edge) (k) (solve))
  )
(define (ecm5)  (display "cm5\n")
  (clear)
  (dedge 20)
  (let ((this-edge ds-model))
    (b)
    (pc 0.5 0.5) (pc 0.0 0.0) (pc 1.0 1.0)
    (tc 0.5 0.5) (tc 0.0 0.0) (tc 1.0 1.0)
    (pp 0.4 0.4) (pp 0.7 0.4) (pp 0.9 0.4) (dp)
    (dp 0   0 0   .3 1)
    (spr .7 .7) (spr .7 .4) (spr .7 .1)
    (solve 2 3) (commit) (end) (set! ds-model this-edge) (k) (solve))
  )
(define (ecm6)  (display "cm6\n")
  (clear)
  (dedge 20) (b)
  (let ((this-edge ds-model)
        (t1 (pc 0.0 0.0))     (t2 (pc 1.0 1.0))
        (t3 (tc 0.0 0.0))     (t4 (tc 1.0 1.0))
        (t6 (pp 0.7 0.4))     (t7 (pp 0.9 0.4))
        (t8 (spr .7 .4))       (t9 (spr .7 .1))
        )
    (pc 0.5 0.5) (tc 0.5 0.5) (pp 0.4 0.4) (dp)
    (dp 0   0 0   .3 1)
    (spr .7 .7)
    (solve 2 3) (commit)
    (delete t1) (delete t2) (delete t3) (delete t4)
    (delete t6) (delete t7) (delete t8) (delete t9)
    (commit) (end) (set! ds-model this-edge) (a) (solve)
    (spr .9 .3) (spr .3 .5) (end) (set! ds-model this-edge)
    (k) (solve)
    ))
         ;; extend the commit sequences with part save and load sequences
         ;; (esave ecm)  = an extension of the cm commands to include save and
         ;;              load sequences.  Argument cm is one of cm0, cm1, cm2
         ;;              cm3, cm4, cm5, or cm6
         
(define (esave ecm)
  (display "save ")
  (part:clear)
  (set! ds-model '())
  (ecm)
  (if (entity:displayed? ds-model)
      (display "ds-model displayed\n")
      (display "ds-model not displayed\n"))
  (display "saving part\n")
  (part:save "temp.tmp")
  (part:clear)
  (display "retrieving part\n")
  (set! ds-entity-list (part:load "temp.tmp"))
  (set! ds-model (car (entity:edges (car ds-entity-list))))
  (entity:erase ds-model)
  (ds:mouse ds-model #f)
  (solve)
  )
         
         ;; base case for split and elevate-degree tests
         ;; build a degree one spline for a square face
         ;; base-face = create a simple spline and use split and
         ;;             elevate-degree to increase its dof count
(define (base-edge)
  (display "base-edge\n")
  (end)
  (set! ds-model               ; make NUB face
        (ds:test-edge 2 36 36      ; cpt_count, x_size, z_size
                      ds-rational-flag 1))   ; rational, degree, u_min, u_max
  (entity:erase ds-model)
  (ds:mouse ds-model #f)
  (k) (e)
  (inc-degree)
  (inc-degree)
  (split .5 .5 1)
  (solve)
  )    ;; on outpuput degree = 5, elem_count = 2
         
         
         ;; extension of base-face to test rollback
(define (ds-edge-roll)
  (display "ds-roll\n")
  (base-edge)
  (split .16666 .3333 .6666 .8333)
  (display "commit0\n")
  (roll:name-state "commit0")
  (commit)
  (display "commit1\n")
  (roll:name-state "commit1")
  (set! ds-cc1 (pc .5 .5))
  (sxyz ds-cc1 18 18 10)
  (commit)
  (display "commit2\n")
  (roll:name-state "commit2")
  (sxyz ds-cc1 18 18 25)
  (commit)
  (display "commit3\n")
  (roll:name-state "commit3")
  (display "roll commit0\n") (roll "commit0") (refacet)
  (display "roll commit1\n") (roll "commit1") (refacet)
  (display "roll commit2\n") (roll "commit2") (refacet)
  (display "roll commit3\n") (roll "commit3") (refacet)
  
  (display "roll commit2\n") (roll "commit2") (refacet)
  (display "roll commit0\n") (roll "commit0") (refacet)
  (display "roll commit3\n") (roll "commit3") (refacet)
  (display "roll commit1\n") (roll "commit1") (refacet)
  
  (ds:mouse '())
  )
         
         ;; sequence to exercise the spring command
(define (spring-edge-group)
  (display "spring-edge-group\n")
  (dedge 20) 
  (ds:set-default-shape ds-model 1 0) (toggle 2) (toggle 3)
  (ds:add-spring ds-model 1 (par-pos .05 .05) (position  0  0 1) 200)
  (ds:add-spring ds-model 1 (par-pos .10 .10) (position  3  1 1) 200)
  (ds:add-spring ds-model 1 (par-pos .15 .15) (position  6  2 1) 200)
  (ds:add-spring ds-model 1 (par-pos .20 .20) (position 10 15 1) 200)
  (ds:add-spring ds-model 1 (par-pos .50 .50) (position 18 24 1) 200)
  (ds:add-spring ds-model 1 (par-pos .55 .55) (position 21 21 1) 200)
  (ds:add-spring ds-model 1 (par-pos .70 .70) (position 30 26 1) 200)
  (ds:add-spring ds-model 1 (par-pos .95 .95) (position 39 36 1) 200)
  (k) (solve)
  )
         
(define (ds-edge-everything)
  (do-nubs)
  (pinned-edge)  (solve) (hinged-edge)  (solve) (pinned-hinged-edge) (solve)
  (pinned2-edge) (solve) (hinged2-edge) (solve) (pinned-hinged2-edge) (solve)
  (folding-edge) (solve)
  (save ecm0)    (solve) (save ecm1) (solve) (save ecm2) (solve) (save ecm3)
  (save ecm4)    (solve) (save ecm5) (solve) (save ecm6) (solve)
  (base-edge)    (solve) 
  ;(ds-edge-roll) (solve) 
  (spring-edge-group) (solve)
  (pinned-edge 15) 
  ;(ds-call-all) (solve)
  (flight-path) (solve) (pull-path) (solve)
  (save ecm6) (solve)
  (do-nurbs)
  (display "\ntest complete\n")
  (pinned-edge)  (solve) (hinged-edge)  (solve) (pinned-hinged-edge) (solve)
  (pinned2-edge) (solve) (hinged2-edge) (solve) (pinned-hinged2-edge) (solve)
  (folding-edge) (solve)
  (save ecm0)    (solve) (save ecm1) (solve) (save ecm2) (solve) (save ecm3)
  (save ecm4)    (solve) (save ecm5) (solve) (save ecm6) (solve)
  (base-edge)    (solve) 
  ;(ds-edge-roll) (solve) 
  (spring-edge-group) (solve)
  (pinned-edge 15) 
  ;(ds-call-all) (solve)
  (flight-path) (solve) (pull-path) (solve)
  (save ecm6) (solve)
  (do-nubs)
  (pull-path) (solve)
  )
         
         
